TITL DAI FIRMWARE 0E602-0E79C  V1.0  Rev.1
        ORG   :E602
*
*
*
********************
* RUN SCREEN ERROR *
********************
*
* Entry: A: Error code: 01: Off screen.
*                       02: Colour not available.
SCRER   CPI   :01       Code is 1?
        MVI   A,:11
        JZ    :D9F5     Then run error 'OFF SCREEN'
        MVI   A,:10     Else: run error
        JMP   :D9F5     'COLOUR NOT AVAILABLE'
*
***********************
* RUN basiccmd COLORT *
***********************
*
RCOLT   CALL  :E61C     Get colours in scratch area
        RST   5         Set text colours
        DATA  :06
        ORA   A         No special action
        RET
*
***********************
* RUN basiccmd COLORG *
***********************
*
RCOLG   CALL  :E61C     Get colours in scratch area
        RST   5         Set graphic colours
        DATA  :1B
        ORA   A         No special action
        RET
*
***********************************
* GET 4 COLOURS INTO SCRATCH AREA *
***********************************
*
* Colour data from a program line are stored in
* scratch area SCOLT/SCOLG (#0119-011C).
*
* Exit: HL: Points to start scratch area.
*
R4COL   LXI   H,:0119   Startaddr SCOLT/SCOLG area
        PUSH  H
R4C10   MVI   A,:0F
        CALL  :E743     Get one colour (0-15)
        MOV   M,A       Store it in scratch area
        INX   H
        MOV   A,L
        CPI   :1D       4 colours done?
        JNZ   :E620     Next if not
        POP   H
        RET
*
********************
* RUN basiccmd DIM *
********************
*
* Entry: BC: points to program line.
*
RDIM    LDAX  B         Get nr of items
        INX   B
RDM05   ORA   A
        RZ              Abort if no items or ready
        DCR   A         Item count
        PUSH  PSW       Preserve count
        CALL  :E95A     Get pnr to array in HL;
 REM type in A
        PUSH  H         Preserve pntr
        CALL  :CE5C     Erase array if existing
        ANI   :30       Get type only
        LXI   D,:0004   Length array element if
 REM FPT/INT
        CPI   :20       String type?
        JNZ   :E648     Jump if not
        MVI   E,:02     Length STR array element
RDM10   LDAX  B         Get number of elements
        INX   B
        MOV   H,A       ) In H and in L
        MOV   L,A       )
        XCHG
 REM
* Calculate total required length:
 REM
RDM20   CALL  :E74F     Get length next dimension
        PUSH  PSW       Remember it
        INR   A         Length +1
        CALL  :EDF0     Calc reqd space
        JC    :DA15     Run error 'NUMBER OUT
 REM OF RANGE' if total space
 REM > 64K
        DCR   D         nr of elements -1
        JNZ   :E64D     Next element if not ready
 REM
* Find space in heap:
 REM
        DCR   H
        INR   H
        JM    :DA15     Run error 'NUMBER OUT OF
 REM RANGE' if > 32K reserved
        DAD   D
        INX   H         Size of space reqd in HL
        PUSH  D
        XCHG
        CALL  :E68B     Get space of size needed
        POP   D
        MOV   M,E       Store nr of elements
        DAD   D         Last element
 REM
* Elements into heap:
 REM
RDM30   POP   PSW       Get length 1 element
        MOV   M,A       Store it in memory
        DCX   H
        DCR   E
        JNZ   :E66B     Next element to memory
*
        XCHG
        POP   H         Get pntr to array
        MOV   M,E       )
        INX   H         ) Set pointer
        MOV   M,D       )
        POP   PSW       Get item count in A
        JMP   :E631     Next item
*
****************************
* part of RUN TALK (0EE94) *
****************************
*
* Entry: A: Code for osc.channel SHR 1.
*
MPT47   DAD   H
RTK50   LXI   D,:0294   Addr volumes osc. 0,1
        ANI   :01       Code SHR 1 only
        ADD   E
        MOV   E,A       DE=#0294 for osc.0,1;
 REM DE=#0295 for osc.2,N
        MOV   A,H       Get mask
        CMA             Complement it
        XCHG            Mask + vol in DE, addr
 REM POR0M/POR1M in HL
        ANA   M         Part to be preserved from
 REM old POR0M/POR1M
        ORA   E         Add new volume
        JMP   :EA40     Continu
*
**********************
* REQUEST HEAP SPACE *
**********************
*
* Part of Run 'DIM' (0E665).
* Requests space from Heap and fills it with
* zeroes.
*
* Entry: DE: Size needed.
* Exit:  HL: Points to data area (after length
*            bytes).
*        AFDE corrupted.
*
ZHREQ   DCR   D
        INR   D
        JM    :DA15     Run error 'NUMBER OUT OF
 REM RANGE' if >32K reqd
        CALL  :D1C5     Run Heap request
        INX   H
        INX   H         HL pnts after length byte
        PUSH  H
        XCHG            Start data area in DE
        DAD   D         End area in HL
        XRA   A
        CALL  :DE7C     Load bank with '0'
        POP   H
        RET
*
*******************
* RUN basiccmd UT *
*******************
*
* Valid as direct command only.
*
RUT     XRA   A
        STA   :02B9     Enable complete keyb scan
        RST   1         Go to utility
        DATA  :09
*
**********************
* RUN basiccmd CALLM *
**********************
*
RCALM   LXI   H,:E6B3   Returnaddr from Utility
        PUSH  H         on stack
        CALL  :E6F8     Get UT addr in HL
        PUSH  H         UT addr on stack
        LDAX  B         Get next expr
        CPI   :FF       End marker?
        JNZ   :E963     If not: Get varptr of given
 REM variable in HL, T/L in A
        INX   B
RCM10   ORA   A         No special action
        RET             On entry: Goto UT addr
 REM On exit: Back to Basic
 REM monitor
*
**********************
* RUN basiccmd CLEAR *
**********************
*
RCLEAR  CALL  :D87F     Get space reqd in HL
 REM (CY=1 if > 32K)
        CALL  :CEBB     Must be >=4 bytes, else run
 REM error 'NUMBER OUT OF RANGE'
        XCHG
        SHLD  :029D     Set Heap size
        LHLD  :029F     Get startaddr. textbuf
        PUSH  H
        CALL  :CB23     Empty Heap + symtab
        PUSH  D
        CALL  :D195     Set Heap to all available
        POP   H
        JMP   :D214     Continu
*
******************************
* Run basiccmds TRON - TROFF *
******************************
*
* Sets or resets the trace flag.
*
* RTRON: Set trace flag.
* RTROF: Reset trace flag.
*
* Entry: none.
* Exit:  Z=1: Flag reset.
*        Z=0: Flag set.
*
RTRON   MVI   A,:FF
RTR10   STA   :0115     Set trace flag
        ORA   A         No special action
        RET
*
RTROF   XRA   A
        JMP   :E6D0     Reset trace flag
*
*******************
* READ LINENUMBER *
*******************
*
* Entry: BC: Points to linenumber.
* Exit:  Z=0: Linenumber in HL.
*        Z=1: HL preserved.
*        BC updated, DE preserved, AF corrupted.
*
RLN     PUSH  H
        LDAX  B
        INX   B
        MOV   H,A       )
        LDAX  B         ) Get linenr in HL
        INX   B         )
        MOV   L,A       )
        ORA   H
        JZ    :E6E5     Abort if linenr is 0
        XTHL            Linenr on stack
RLN10   POP   H         Old HL or linenr in HL
        RET
*
*********************************************
* READ LINENUMBER AND FIND IT IN TEXTBUFFER *
*********************************************
*
* Entry: BC: Points to linenumber.
* Exit:  BC updated, DE preserved, AF corrupted
*        (RLNF) or preserved (RLNFI).
*        HL: Points to 1st linenr >= reqd. number.
*        CY=1: Linenumber found.
*        CY=0: Not found.
*
RLNF    CALL  :E6D9     Get linenr in HL
        JMP   :CAF6     Find it in textbuffer
 REM
* Idem as RLNF, but with error reporting:
 REM
RLNFI   PUSH  PSW
        CALL  :E6E7     Read linenr and find it
        MVI   A,:04
        JNC   :D9F5     Run error 'UNDEFINED NUMBER'
 REM if not found
        POP   PSW
        RET
*
*******************************************
* RUN A INT EXPRESSION WITH 2-BYTE RESULT *
*******************************************
*
* Evaluates a 16-bit INT expression (in range 0-
* FFFF). The result is in HL.
*
* Entry: BC: Points to expression.
* Exit:  HL: Result.
*        BC updated, AFDE corrupted.
*
REXI2   PUSH  PSW
        PUSH  D
        CALL  :E819     Eval arguments in num expr
 REM Result in MACC or in WORKE
        MOV   A,H
        ORA   L
        JZ    :E710     Jump if result in MACC
 REM
* If result in WORKE:
 REM
        MOV   A,M       )
        INX   H         ) Check if > 2 bytes
        ORA   M         )
        JNZ   :DA15     Then run error 'NUMBER OUT
 REM OF RANGE'
        INX   H
        MOV   A,M       )
        INX   H         ) Get result in HL
        MOV   L,M       )
        MOV   H,A       )
        POP   D
        POP   PSW
        RET
 REM
* If result in MACC:
 REM
RX210   PUSH  B
        RST   4         Copy MACC to reg A,B,C,D
        DATA  :15
        ORA   B         Check if > 2 bytes
        JNZ   :DA15     Then run error 'NUMBER OUT
 REM OF RANGE'
        MOV   L,D       ) Result in HL
        MOV   H,C       )
        POP   B
        POP   D
        POP   PSW
        RET
*
*******************************
* RUN A 1-BYTE INT EXPRESSION *
*******************************
*
* Evaluates a 8-bit INT expression (range 0-
* FF). Result in A.
*
* Entry: BC: Points to expression.
* Exit:  A: Result.
*        BC updated, DEHL preserved.
*
REXI1   PUSH  D
        PUSH  H
        CALL  :E819     Eval arguments in num expr
 REM Result in MACC or WORKE
        MOV   A,H
        ORA   L
        JZ    :E736     If HL=0: Get result frm MACC
 REM
* Result in WORKE:
 REM
        MOV   A,M       )
        INX   H         )
        ORA   M         ) Check if > 1 byte
        INX   H         )
        ORA   M         )
        JNZ   :DA15     Then run error 'NUMBER OUT
 REM OF RANGE'
        INX   H
        MOV   A,M       Get result in A
        POP   H
        POP   D
        RET
 REM
* If result in MACC (also entry from REXF1):
 REM
RX110   PUSH  D
        PUSH  H
RX120   POP   H
        PUSH  B
        RST   4         Copy MACC to reg A,B,C,D
        DATA  :15
        ORA   B         ) Check if > 1 byte
        ORA   C         )
        JNZ   :DA15     Then run error 'NUMBER OUT
 REM OF RANGE'
        MOV   A,D       Get result in A
        POP   B
        POP   D
        RET
*
************************************************
* RUN 1-BYTE INT EXPRESSION WITH LIMITED RANGE *
************************************************
*
* Entry: BC: Points to expression.
*        A:  Range of arguments (<=FE).
* Exit:  BC updated, DEHL preserved, F corrupted.
*        A:  Result.
*
REXIL   PUSH  D
        MOV   D,A       Argument range in D
        CALL  :E71D     Get value of argument in A
        INR   D
        CMP   D         Out of range ? Then run
        JNC   :DA15     error 'NUMBER OUT OF RANGE'
        POP   D
        RET
*
*********************************************
* CHECK VARIABLE TYPE AND GET ITS INT VALUE *
*********************************************
*
* Entry: BC: Points to expression.
* Exit:  Error: If string type.
*        If OK: Value in A (FPT: converted to INT).
*               BC updated, DEHL preserved.
*
REX1    LDAX  B         Get var. type byte
        INX   B
        CPI   :20       String type?
        JZ    :DA1A     Then run error 'TYPE
 REM MISMATCH'
        CPI   :10       INT type?
        JZ    :E71D     Then get value in A
 REM
* If FPT:
 REM
REXF1   CALL  :E808     Get value in MACC
        RST   4         Change it to INT
        DATA  :48
        JMP   :E734     Get value in A
*
*======================================*
* RUN EXPRESSIONS WITH OPERATOR PREFIX *
*======================================*
*
* #E763-EBED evaluate logical, FPT, INT or STR
* expressions in 'operator prefix' format.
*
* Register allocation during operation:
*    INT/FPT: D=0:   MACC empty.
*             E:     Operator.
*             HL=0:  Result in MACC.
*             HL<>0: HL points to result.
*    STR:     HL:    Points to string.
*             E:     Type of string (constant [0],
*                    variable [1], temporary [2]).
*
*********************************
* EVALUATE A LOGICAL EXPRESSION *
*********************************
*
REXPL   MVI   D,:00     MACC free
        LDAX  B         Get byte
        ANI   :60
        CPI   :40       String ?
        JZ    :E7BD     Then jump
        LDAX  B         Get byte
        ANI   :1F
        CPI   :18       Relational operator?
        JC    :E850     If not: eval expr which
 REM begins with num operator
        INX   B
        CPI   :1A       Bracket?
        JZ    :E763     Then ignore it
 REM
* Logical AND or OR:
 REM
        PUSH  PSW       Preserve type of operation
        CALL  :E763     Get 1st operand
        PUSH  PSW       Preserve it
        CALL  :E763     Get 2nd operand
        POP   D         1st operand in D
        PUSH  PSW       Preserve 2nd operand
        ANA   D         AND operation
        MOV   E,A       Result in E
        POP   PSW       2nd operand in A
        ORA   D         OR operation
        MOV   D,A       Result in D
        POP   PSW       Type of operation in F
        MOV   A,D       Result OR in A
        JPE   :E790     Quit if OR
        MOV   A,E       Result AND in A
RXL10   RET
*
******************************
* EVALUATE STRING EXPRESSION *
******************************
*
* This routine returns temporary strings before
* they are really free.
* The heap is cleared if it is a temporary string.
*
* Entry: BC: Points to expression.
* Exit:  BC updated, AFD corrupted.
*        HL: Points to string.
*        E:  Status.
*
REXSR   CALL  :E79D     Evaluate string expr
        MOV   A,E       Get status
        CPI   :02       Temporary ?
        PUSH  H
        CZ    :D187     Then clear heap entry
        POP   H
        RET
*
*
*
        END